package cluster_from_pairs;

require Exporter;


our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(   cluster_from_pairs);

use strict;
use warnings;
use Carp;
	
	
	
#_________________________________________________________________________________________

#	lookup_gene_index

#_________________________________________________________________________________________
sub lookup_gene_index($\@\%\%)
{
	my ($gene_name, $gene_to_cluster, $gene_to_index, $gene_from_index) = @_;
	if (!exists $gene_to_index->{$gene_name})
	{
		# start with cluster zero (unclustered)
		push(@$gene_to_cluster, 0);

		# remember index of gene as position in array gene_to_cluster
		my $gene_index = @$gene_to_cluster - 1;
		$gene_from_index->{$gene_index} = $gene_name;
		$gene_to_index->{$gene_name} = $gene_index;
		return $gene_index;
	}
	
	return $gene_to_index->{$gene_name};
}

sub get_cluster_total(\@)
{
	my ($gene_clusters) = @_;
	my %all_genes;
	for my $gene_cluster(@$gene_clusters)
	{
		++$all_genes{$_} for (@$gene_cluster);
	}
	return scalar keys %all_genes;

}
#_________________________________________________________________________________________

#	cluster_from_pairs

#		input:	gene_pairs
#		output:	cluster of genes (array of array of genes)

#_________________________________________________________________________________________
sub cluster_from_pairs($)
{
	my ($gene_pairs) = @_;
	
	# which cluster a particular gene belongs to:
	# : gene_to_cluster[gene_index] = cluster_index
	my @gene_to_cluster;
	
	# look up gene_index from gene_name
	my %gene_to_index;
	my %gene_from_index;
	
	
	# each entry is an array of gene_index in that cluster
	my @gene_clusters = ([]);
	
	for my $gene_pair(@$gene_pairs)
	{
		# print STDERR ">>> $gene_pair->[0] , $gene_pair->[1]  <<<\n";
		
		# get indices of genes
		my $gene1 = lookup_gene_index($gene_pair->[0], @gene_to_cluster, 
									  %gene_to_index, %gene_from_index);
		my $gene2 = lookup_gene_index($gene_pair->[1], @gene_to_cluster, 
									  %gene_to_index, %gene_from_index);
		
		my $curr_cluster1 = \$gene_to_cluster[$gene1];
		my $curr_cluster2 = \$gene_to_cluster[$gene2];
		
		#
		# add new cluster if neither is yet clustered
		#
		if ($$curr_cluster1 + $$curr_cluster2 == 0)
		{
			# cluster index for these two genes
			$$curr_cluster1 =
			$$curr_cluster2 = scalar @gene_clusters;
			
			# these two genes make up a new cluster
			push(@gene_clusters, [$gene1, $gene2]);
			# print STDERR "\tNew cluster $gene1=$gene_from_index{$gene1}, ".
			# 			"$gene2=$gene_from_index{$gene2} in cluster = ",
			# 			@gene_clusters - 1, "\n";
		}
		
		
		#
		# link cluster 2 to cluster 1 if both already have clusters
		#
		elsif ($$curr_cluster1 && $$curr_cluster2)
		{
			next if $$curr_cluster1 == $$curr_cluster2;
			my $cluster1_genes = $gene_clusters[$$curr_cluster1];
			my $cluster2_genes = $gene_clusters[$$curr_cluster2];
			
			# print STDERR "\tMerge clusters $$curr_cluster1 <= $$curr_cluster2 \n";
			# print STDERR "\tBefore: cluster 1= ";
			# print STDERR $gene_from_index{$_}, "," for (@$cluster1_genes);
			# print STDERR "\n";
			# print STDERR "\tBefore: cluster 2= ";
			# print STDERR $gene_from_index{$_}, "," for (@$cluster2_genes);
			# print STDERR "\n";
			
			
			# save old cluster id 
			# (will be obliterated when assign cluster id of 1 to cluster 2)
			my $old_cluster = $$curr_cluster2;
			
			# merge cluster 2 into cluster 1
			push(@$cluster1_genes, @$cluster2_genes);
			
			# assign curr_cluster1 to all of curr_cluster2 genes;
			$gene_to_cluster[$_] = $$curr_cluster1 for (@$cluster2_genes);
		
			# cluster 2 holds nothing now
			$gene_clusters[$old_cluster] = [];
			
		}
		
		#
		# add gene 2 to cluster 1 if gene 2 is unclustered
		#
		elsif ($$curr_cluster1)
		{
			$$curr_cluster2 = $$curr_cluster1;
			my $cluster1_genes = $gene_clusters[$$curr_cluster1];
			push(@$cluster1_genes, $gene2);
		
			# print STDERR "\tAdd to cluster $$curr_cluster1 <= $gene_from_index{$gene2} \n";
			# print STDERR "\tAfter: cluster $$curr_cluster1= ";
			# print STDERR $gene_from_index{$_}, "," for (@$cluster1_genes);
			# print STDERR "\n";
		}
	
		#
		# add gene 1 to cluster 2 if gene 1 is unclustered
		#
		else
		{
			$$curr_cluster1 = $$curr_cluster2;
			my $cluster2_genes = $gene_clusters[$$curr_cluster2];
			push(@$cluster2_genes, $gene1);
		
			# print STDERR "\tAdd to cluster $$curr_cluster2 <= $gene_from_index{$gene1} \n";
			# print STDERR "\tAfter: cluster $$curr_cluster2= ";
			# print STDERR $gene_from_index{$_}, "," for (@$cluster2_genes);
			# print STDERR "\n";
		}
		
	}
	my @final_gene_clusters;
	#
	# copy non-empty clusters to output set
	#
	for my $gene_cluster(@gene_clusters)
	{
		next unless @$gene_cluster;
		push(@final_gene_clusters,
			 [map {$gene_from_index{$_};} @$gene_cluster]);
	}
	
	return @final_gene_clusters;
}

1;
